(* Yoann Padioleau
 *
 * Copyright (C) 2021 Semgrep Inc.
 *
 * This library is free software; you can redistribute it and/or
 * modify it under the terms of the GNU Lesser General Public License
 * version 2.1 as published by the Free Software Foundation, with the
 * special exception on linking described in file LICENSE.
 *
 * This library is distributed in the hope that it will be useful, but
 * WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the file
 * LICENSE for more details.
 *)
open Common
open Either_
module H = AST_generic_helpers
open Ast_cpp
open OCaml (* for the map_of_xxx *)
module G = AST_generic
module Log = Log_parser_cpp.Log

(* See Parse_cpp_tree_Sitter.recover_when_partial_error *)
(* nosemgrep: no-ref-declarations-at-top-scope *)
let recover_when_partial_error = ref true

(*****************************************************************************)
(* Prelude *)
(*****************************************************************************)
(* Ast_cpp to AST_generic.
 *
 * See ast_generic.ml for more information.
 *
 * TODO: copy code from ast_c_build.ml, like the ifdef_skipper
 * TODO: copy code from c_to_generic.ml, like DeRef unsugaring
 *)

(*****************************************************************************)
(* Helpers *)
(*****************************************************************************)

type scope = InFunction | InClass | TopLevel
type mode = Pattern | Target
type cpp_parsing_option = [ `AsFunDef | `AsVarDefWithCtor ]

type env = {
  mutable defs_toadd : G.definition list;
  mutable in_scope : scope;
  mutable in_mode : mode;
  mutable parsing_pref : cpp_parsing_option option;
}

let empty_env () =
  {
    defs_toadd = [];
    in_scope = TopLevel;
    in_mode = Target;
    parsing_pref = None;
  }

let error t s = raise (Parsing_error.Other_error (s, t))

(* See Parse_cpp_tree_sitter.error_unless_partial error *)
let error_unless_partial_error _env t s =
  if not !recover_when_partial_error then error t s
  else
    Log.err (fun m ->
        m "error_unless_partial_error: %s, at %s" s (Tok.stringpos_of_tok t))

let empty_stmt tk = Compound (tk, [], tk)
let _id x = x
let fb = Tok.unsafe_fake_bracket

let map_either _env f g x =
  match x with
  | Either.Left x -> Either.Left (f x)
  | Either.Right x -> Either.Right (g x)

(* alt: change AST_generic.ml instead to take more expr option? *)
let expr_option t eopt =
  match eopt with
  | Some e -> e
  | None -> G.L (G.Unit t) |> G.e

let _name_option t nopt =
  match nopt with
  | Some n -> n
  | None ->
      (* TODO? gensym? *)
      let fake_id = ("_ANON", t) in
      H.name_of_id fake_id

let distribute_access (xs : (G.field, G.attribute) Either.t list) : G.field list
    =
  let rec aux attr_opt xs =
    match xs with
    | [] -> []
    | x :: xs -> (
        match x with
        | Left fld ->
            (* TODO: use attr_opt to modify fld if it's a def
             * and add the access modifier *)
            fld :: aux attr_opt xs
        | Right attr -> aux (Some attr) xs)
  in
  aux None xs

(* crazy https://en.cppreference.com/w/cpp/language/template_parameters
 * TODO: try to convert to type_parameter_classic when can
 *)
let parameter_to_type_parameter (p : G.parameter) : G.type_parameter =
  G.OtherTypeParam (("Param", G.fake ""), [ G.Pa p ])

let def_or_dir_either_to_stmt = function
  | Left dir -> G.DirectiveStmt dir |> G.s
  | Right def -> G.DefStmt def |> G.s

let any_of_either_type_expr = function
  | Left t -> G.T t
  | Right e -> G.E e

let map_def_in_stmt f st =
  match st.G.s with
  | DefStmt (ent, def) ->
      let ent, def = f (ent, def) in
      { st with s = DefStmt (ent, def) }
  (* less: raise an error? *)
  | _ -> st

let is_primitive_type = function
  | TPrimitive _ -> true
  | TypeName (_, _, IdIdent (tyname, _)) -> (
      match tyname with
      | "void"
      | "bool"
      | "char"
      | "int"
      | "float"
      | "double" ->
          true
      | _ -> false)
  | _ -> false

(*****************************************************************************)
(* Conversions *)
(*****************************************************************************)

(* generated by ocamltarzan with: camlp4o -o /tmp/yyy.ml -I pa/ pa_type_conv.cmo pa_map_todo.cmo  pr_o.cmo /tmp/xxx.ml  *)

let map_tok _env v = v

let map_wrap env _of_a (v1, v2) =
  let v1 = _of_a v1 and v2 = map_tok env v2 in
  (v1, v2)

let map_paren env _of_a (v1, v2, v3) =
  let v1 = map_tok env v1 and v2 = _of_a v2 and v3 = map_tok env v3 in
  (v1, v2, v3)

let map_paren_skip _env _of_a (_v1, v2, _v3) = _of_a v2

let map_brace env _of_a (v1, v2, v3) =
  let v1 = map_tok env v1 and v2 = _of_a v2 and v3 = map_tok env v3 in
  (v1, v2, v3)

let map_bracket env _of_a (v1, v2, v3) =
  let v1 = map_tok env v1 and v2 = _of_a v2 and v3 = map_tok env v3 in
  (v1, v2, v3)

let map_angle env _of_a (v1, v2, v3) =
  let v1 = map_tok env v1 and v2 = _of_a v2 and v3 = map_tok env v3 in
  (v1, v2, v3)

let map_sc env v = map_tok env v
let map_todo_category env v : G.todo_kind = map_wrap env map_of_string v
let map_ident env v = map_wrap env map_of_string v

let rec map_name env (v1, v2, v3) : G.name =
  let v1 = map_of_option (map_tok env) v1
  and v2 = map_of_list (map_qualifier env) v2
  and v3 = map_ident_or_op env v3 in
  match (v1, v2, v3) with
  | None, [], (id, None) -> H.name_of_id id
  | _ ->
      G.IdQualified
        {
          G.name_last = v3;
          name_top = v1;
          name_middle = (if v2 =*= [] then None else Some (QDots v2));
          name_info = G.empty_id_info ();
        }

and map_ident_or_op (env : env) = function
  | IdIdent v1 ->
      let v1 = map_ident env v1 in
      (v1, None)
  | IdTemplated (v1, v2) ->
      (* todo: assert _opt is None *)
      let v1, _opt = map_ident_or_op env v1
      and v2 = map_template_arguments env v2 in
      (v1, Some v2)
  | IdOperator (v1, v2) ->
      let t1 = map_tok env v1 in
      let _op, t2 = map_wrap env (map_operator env) v2 in
      let id = (Tok.content_of_tok t2, Tok.combine_toks t1 [ t2 ]) in
      (id, None)
  | IdDestructor (v1, v2) ->
      let t1 = map_tok env v1 and s, t2 = map_ident env v2 in
      let id = (Tok.content_of_tok t1 ^ s, Tok.combine_toks t1 [ t2 ]) in
      (id, None)
  | IdConverter (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_type_ env v2 in
      let ii = AST_generic_helpers.ii_of_any (G.T v2) in
      let s = v1 :: ii |> List_.map Tok.content_of_tok |> String.concat "" in
      let t = Tok.combine_toks v1 ii in
      let id = (s, t) in
      (id, None)
  | IdDeref (v1, v2) ->
      (* Just copying the above. *)
      let v1 = map_tok env v1 and v2 = map_expr env v2 in
      let ii = AST_generic_helpers.ii_of_any (G.E v2) in
      let s = v1 :: ii |> List_.map Tok.content_of_tok |> String.concat "" in
      let t = Tok.combine_toks v1 ii in
      let id = (s, t) in
      (id, None)

and map_template_arguments env (l, v, r) : G.type_arguments =
  let xs = (map_of_list (map_template_argument env)) v in
  (l, xs, r)

and map_template_argument env v : G.type_argument =
  match v with
  | Left t ->
      let t = map_type_ env t in
      G.TA t
  | Right e ->
      let e = map_expr env e in
      G.TAExpr e

and map_qualifier env = function
  | QClassname v1 ->
      let v1 = map_ident env v1 in
      (v1, None)
  | QTemplateId (v1, v2) ->
      let v1 = map_ident env v1 and v2 = map_template_arguments env v2 in
      (v1, Some v2)
  | QTemplateTokId (_v1, v2, v3) ->
      (* THINK: Is this different than without the `template`? *)
      let v2 = map_ident env v2 and v3 = map_template_arguments env v3 in
      (v2, Some v3)
  | QDecltype (v1, v2) ->
      (* AST_generic names definitely cannot accommodate a decltype
         within them.
         It's like a dynamic IdQualified, really more suited for something
         like a DotAccess of a Call to `decltype`, for programs like
         decltype(e)::foo
         Let's just make something up for now.
      *)
      let _v1 = map_tok env v1 and _v2 = map_bracket env (map_expr env) v2 in
      let v1 = ("DecltypeId", G.fake "DecltypeId") in
      (v1, None)

and map_a_class_name env v = map_name env v
and map_a_ident_name env v = map_name env v

and map_type_ env (v1, v2) : G.type_ =
  let v1 = map_type_qualifiers env v1 and v2 = map_typeC env v2 in
  { v2 with t_attrs = v1 }

and map_typeC env x : G.type_ =
  match x with
  | TPrimitive v1 ->
      let v1 = map_wrap env (map_primitive_type env) v1 in
      G.ty_builtin v1
  | TSized (v1, v2) ->
      let v1 = map_of_list (map_sized_type env) v1
      and v2 = map_of_option (map_type_ env) v2 in
      let allt = v1 @ Option.to_list v2 in
      G.OtherType (("TSized", G.fake ""), allt |> List_.map (fun t -> G.T t))
      |> G.t
  | TPointer (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_type_ env v2
      and v3 = map_of_list (map_pointer_modifier env) v3 in
      { t = G.TyPointer (v1, v2); t_attrs = v3 }
  | TReference (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_type_ env v2 in
      G.TyRef (v1, v2) |> G.t
  | TRefRef (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_type_ env v2 in
      G.OtherType (("&&", v1), [ G.T v2 ]) |> G.t
  | TArray (v1, v2) ->
      let v1 = map_bracket env (map_of_option (map_a_const_expr env)) v1
      and v2 = map_type_ env v2 in
      G.TyArray (v1, v2) |> G.t
  | TFunction v1 ->
      let (_, ps, _), tret = map_functionType env v1 in
      G.TyFun (ps, tret) |> G.t
  | TypeName v1 ->
      let v1 = map_a_ident_name env v1 in
      G.TyN v1 |> G.t
  | TypenameKwd (v1, v2) ->
      let _v1 = map_tok env v1 and v2 = map_type_ env v2 in
      v2
  | EnumName (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_a_ident_name env v2 in
      G.OtherType (("EnumName", v1), [ G.T (G.TyN v2 |> G.t) ]) |> G.t
  | EnumDef v1 ->
      let nopt, tdef = map_enum_definition env v1 in
      let ent, othertype =
        match nopt with
        | None ->
            let ent =
              (* todo? gensym *)
              {
                G.name = OtherEntity (("AnonEnum", v1.enum_kind), []);
                attrs = [];
                tparams = None;
              }
            in
            let t = G.OtherType (("AnonEnumName", v1.enum_kind), []) |> G.t in
            (ent, t)
        | Some n ->
            let ent = { G.name = G.EN n; attrs = []; tparams = None } in
            let t =
              G.OtherType (("EnunName", v1.enum_kind), [ G.T (G.TyN n |> G.t) ])
              |> G.t
            in
            (ent, t)
      in
      env.defs_toadd <- (ent, G.TypeDef tdef) :: env.defs_toadd;
      othertype
  | ClassName (v1, v2) ->
      let (_kind, tk), _attrs = map_class_key env v1
      and v2 = map_a_class_name env v2 in
      G.OtherType ((Tok.content_of_tok tk, tk), [ G.T (G.TyN v2 |> G.t) ])
      |> G.t
  | ClassDef ((_, vdef) as v1) ->
      let nopt, cdef = map_class_definition env v1 in
      let _kind, tk = vdef.c_kind in
      let ent, othertype =
        match nopt with
        | None ->
            let ent =
              (* todo? gensym *)
              {
                G.name = OtherEntity (("AnonClass", tk), []);
                attrs = [];
                tparams = None;
              }
            in
            let t = G.OtherType ((Tok.content_of_tok tk, tk), []) |> G.t in
            (ent, t)
        | Some n ->
            let ent = { G.name = G.EN n; attrs = []; tparams = None } in
            let t =
              G.OtherType ((Tok.content_of_tok tk, tk), [ G.T (G.TyN n |> G.t) ])
              |> G.t
            in
            (ent, t)
      in
      env.defs_toadd <- (ent, G.ClassDef cdef) :: env.defs_toadd;
      othertype
  | TypeOf (v1, v2) ->
      let v1 = map_tok env v1
      and _l, v2, _r =
        map_paren env (map_either env (map_type_ env) (map_expr env)) v2
      in
      let any = any_of_either_type_expr v2 in
      G.OtherType (("Typeof", v1), [ any ]) |> G.t
  | TAuto v1 ->
      let v1 = map_tok env v1 in
      G.TyAny v1 |> G.t
  | ParenType v1 ->
      let _l, v1, _r = map_paren env (map_type_ env) v1 in
      v1
  | TypeTodo (v1, v2) ->
      let v1 = map_todo_category env v1
      and v2 = map_of_list (map_type_ env) v2 in
      G.OtherType (v1, v2 |> List_.map (fun t -> G.T t)) |> G.t

and map_primitive_type _env = function
  | TVoid -> "void"
  | TBool -> "bool"
  | TChar -> "char"
  | TInt -> "int"
  | TFloat -> "float"
  | TDouble -> "double"

and map_sized_type env (kind, t) : G.type_ =
  let t = map_tok env t in
  let s =
    match kind with
    | TSigned -> "signed"
    | TUnsigned -> "unsigned"
    | TShort -> "short"
    | TLong -> "long"
  in
  G.ty_builtin (s, t)

and map_type_qualifiers env v : G.attribute list =
  map_of_list (map_qualifier_wrap env) v

and map_qualifier_wrap _env (qu, t) : G.attribute =
  (* old: (map_wrap env (map_type_qualifier env)) *)
  match qu with
  | Const -> G.attr G.Const t
  | Volatile -> G.attr G.Volatile t
  | Restrict -> G.unhandled_keywordattr ("Restrict", t)
  | Atomic -> G.unhandled_keywordattr ("Atomic", t)
  | Mutable -> G.attr G.Mutable t
  | Constexpr -> G.unhandled_keywordattr ("ConstExpr", t)
  | Constinit -> G.unhandled_keywordattr ("ConstInit", t)
  | Consteval -> G.unhandled_keywordattr ("ConstEval", t)
  | NoReturn -> G.unhandled_keywordattr ("noreturn", t)
  | Extension -> G.unhandled_keywordattr ("extension", t)

and map_expr env x : G.expr =
  match x with
  | N v1 ->
      let v1 = map_name env v1 in
      G.N v1 |> G.e
  | C v1 -> map_constant env v1
  | UserDefined (v1, v2) ->
      let v1 = map_constant env v1 in
      OtherExpr (("UserDefined", G.fake "UseDefined"), [ G.E v1; G.I v2 ])
      |> G.e
  | IdSpecial v1 ->
      let v1 = map_special_wrap env v1 in
      v1
  | Call (v1, v2) ->
      let v1 = map_expr env v1
      and v2 = map_paren env (map_of_list (map_argument env)) v2 in
      G.Call (v1, v2) |> G.e
  | CondExpr (v1, v2, v3, v4, v5) ->
      let v1 = map_expr env v1
      and _v2 = map_tok env v2
      and ethen = expr_option v2 (map_of_option (map_expr env) v3)
      and _v4 = map_tok env v4
      and v5 = map_expr env v5 in
      G.Conditional (v1, ethen, v5) |> G.e
  | Sequence (v1, v2, v3) ->
      let v1 = map_expr env v1
      and _v2 = map_tok env v2
      and v3 = map_expr env v3 in
      G.Seq [ v1; v3 ] |> G.e
  | Assign (v1, v2, v3) -> (
      let v1 = map_a_lhs env v1
      and v2 = map_assignOp env v2
      and v3 =
        match v3 with
        | Left x -> map_expr env x
        | Right x -> map_initialiser env x
      in
      match v2 with
      | Left teq -> G.Assign (v1, teq, v3) |> G.e
      | Right op -> G.AssignOp (v1, op, v3) |> G.e)
  | Prefix (v1, v2) ->
      let op, t = map_wrap env (map_fixOp env) v1 and v2 = map_expr env v2 in
      G.special (G.IncrDecr (op, G.Prefix), t) [ v2 ]
  | Postfix (v1, v2) ->
      let v1 = map_expr env v1 and op, t = map_wrap env (map_fixOp env) v2 in
      G.special (G.IncrDecr (op, G.Postfix), t) [ v1 ]
  | Unary (v1, v2) -> (
      let either, t = map_wrap env (map_unaryOp env) v1
      and v2 = map_expr env v2 in
      match either with
      | Left op -> G.opcall (op, t) [ v2 ]
      | Right f -> f t v2)
  | Binary (v1, v2, v3) ->
      let v1 = map_expr env v1
      and v2 = map_wrap env (map_binaryOp env) v2
      and v3 = map_expr env v3 in
      G.opcall v2 [ v1; v3 ]
  | ArrayAccess (v1, v2) ->
      let v1 = map_expr env v1
      and l, v2, r = map_bracket env (map_of_list (map_initialiser env)) v2 in
      let v2 =
        match v2 with
        | [] -> failwith "should not be empty by precondition"
        | [ x ] -> x
        | xs -> Container (List, fb xs) |> G.e
      in
      G.ArrayAccess (v1, (l, v2, r)) |> G.e
  | DotAccess (v1, v2, v3) -> (
      let v1 = map_expr env v1
      and either, tdot = map_wrap env (map_dotOp env) v2
      and v3 = map_name env v3 in
      match either with
      | Dot -> G.DotAccess (v1, tdot, G.FN v3) |> G.e
      | Arrow ->
          let v1 = G.DeRef (tdot, v1) |> G.e in
          G.DotAccess (v1, tdot, G.FN v3) |> G.e)
  | DotStarAccess (v1, v2, v3) -> (
      let v1 = map_expr env v1
      and either, tdot = map_wrap env (map_dotOp env) v2
      and v3 = map_expr env v3 in
      let e = G.DeRef (tdot, v3) |> G.e in
      match either with
      | Dot -> G.DotAccess (v1, tdot, G.FDynamic e) |> G.e
      | Arrow ->
          let v1 = G.DeRef (tdot, v1) |> G.e in
          G.DotAccess (v1, tdot, G.FDynamic e) |> G.e)
  | Cast (v1, v2) ->
      let l, t, _r = map_paren env (map_type_ env) v1
      and v2 = map_expr env v2 in
      G.Cast (t, l, v2) |> G.e
  | StatementExpr v1 ->
      let l, (_, xs, _), r = map_paren env (map_compound env) v1 in
      let st = G.Block (l, xs, r) |> G.s in
      G.stmt_to_expr st
  | GccConstructor (v1, v2) ->
      let lpar, t, _rpar = map_paren env (map_type_ env) v1
      and lbrace, xs, rbrace =
        map_brace env (map_of_list (map_initialiser env)) v2
      in
      G.New
        (lpar, t, G.empty_id_info (), (lbrace, xs |> List_.map G.arg, rbrace))
      |> G.e
  | Generic (tk, (_l, (e, assocs), _r)) ->
      let e = map_expr env e in
      let cond =
        G.Cond (Call (Special (Typeof, tk) |> G.e, fb [ G.Arg e ]) |> G.e)
      in
      let cases =
        List_.map
          (fun (ty, e) ->
            G.CasesAndBody
              ( [ G.Case (G.fake "", G.PatType (map_type_ env ty)) ],
                G.ExprStmt (map_expr env e, G.sc) |> G.s ))
          assocs
      in
      StmtExpr (G.Switch (tk, Some cond, cases) |> G.s) |> G.e
  | ConstructedObject (v1, v2) ->
      let t = map_type_ env v1 and l, args, r = map_obj_init env v2 in
      if snd v1 |> is_primitive_type then
        (* object construction of primitive types e.g. int() *)
        G.OtherExpr (("PrimitiveObject", l), [ T t; Args args ]) |> G.e
      else
        G.New (Tok.fake_tok l "new", t, G.empty_id_info (), (l, args, r)) |> G.e
  | TypeId (v1, v2) ->
      let v1 = map_tok env v1
      and _l, either, _r =
        map_paren env (map_either env (map_type_ env) (map_expr env)) v2
      in
      let any = any_of_either_type_expr either in
      G.OtherExpr (("TypeId", v1), [ any ]) |> G.e
  | CplusplusCast (v1, v2, v3) ->
      let optodo, t = map_wrap env (map_cast_operator env) v1
      and langle, typ, _rangle = map_angle env (map_type_ env) v2
      and _lpar, e, rpar = map_paren env (map_expr env) v3 in
      let ecall = G.OtherExpr ((optodo, t), []) |> G.e in
      G.Call (ecall, (langle, [ G.ArgType typ; G.Arg e ], rpar)) |> G.e
  | New (v1, v2, v3, v4, v5) ->
      let _topqualifierTODO = map_of_option (map_tok env) v1
      and v2 = map_tok env v2
      and v3 = map_of_option (map_paren env (map_of_list (map_argument env))) v3
      and v4 = map_type_ env v4
      and v5 = map_of_option (map_obj_init env) v5 in
      let v4 =
        match v3 with
        | Some (l, args, _r) ->
            (* store the placement expression in the type attribute *)
            {
              v4 with
              t_attrs =
                OtherAttribute (("placement", l), [ Args args ]) :: v4.t_attrs;
            }
        | None -> v4
      in
      let l, args, r =
        match v5 with
        | None -> Tok.unsafe_fake_bracket []
        | Some (l, args, r) -> (l, args, r)
      in
      G.New (v2, v4, G.empty_id_info (), (l, args, r)) |> G.e
  | Delete (v1, v2, v3, v4) -> (
      let _topqualifierTODO = map_of_option (map_tok env) v1
      and v2 = map_tok env v2
      and v3 = map_of_option (map_bracket env map_of_unit) v3
      and v4 = map_expr env v4 in
      match v3 with
      | None ->
          (* delete <expr> *)
          G.OtherStmt (OS_Delete, [ G.Tk v2; G.E v4 ]) |> G.s |> G.stmt_to_expr
      | Some (l, (), r) ->
          (* delete[] <expr>  *)
          (* THINK: Add a parameter to `OS_Delete` instead ? *)
          G.OtherStmt (OS_Delete, [ G.Tk v2; G.Tk l; G.Tk r; G.E v4 ])
          |> G.s |> G.stmt_to_expr)
  | Throw (v1, v2) ->
      let v1 = map_tok env v1
      and v2 = expr_option v1 (map_of_option (map_expr env) v2) in
      let st = G.Throw (v1, v2, G.sc) |> G.s in
      G.stmt_to_expr st
  | Lambda v1 ->
      let v1 = map_lambda_definition env v1 in
      G.Lambda v1 |> G.e
  | ParamPackExpansion (v1, v2) ->
      let v1 = map_expr env v1 and v2 = map_tok env v2 in
      G.OtherExpr (("Pack", v2), [ G.E v1 ]) |> G.e
  | FoldExpr (v1, v2, v3) ->
      (* TODO: actally migrate to real operators? *)
      let e =
        match v2 with
        | LeftFold (tok, opwrap, expr) ->
            G.OtherExpr
              ( ("LeftFold", G.fake "LeftFold"),
                [ G.Tk tok; G.Tk (snd opwrap); G.E (map_expr env expr) ] )
            |> G.e
        | RightFold (expr, opwrap, tok) ->
            G.OtherExpr
              ( ("RightFold", G.fake "RightFold"),
                [ G.E (map_expr env expr); G.Tk (snd opwrap); G.Tk tok ] )
            |> G.e
        | BinaryFold (e1, (ow1, tk, ow2), e2) ->
            G.OtherExpr
              ( ("BinaryFold", G.fake "BinaryFold"),
                [
                  G.E (map_expr env e1);
                  G.Tk (snd ow1);
                  G.Tk tk;
                  G.Tk (snd ow2);
                  G.E (map_expr env e2);
                ] )
            |> G.e
      in
      H.set_e_range v1 v3 e;
      e
  (* Requires expressions and requires clauses are different things. See:
     https://en.cppreference.com/w/cpp/language/constraints#Requires_clauses
  *)
  | RequiresExpr (v1, (_l1, v2, _r1), (_l2, v3, _r2)) ->
      let params =
        v2 |> List_.map (map_parameter env) |> List_.map (fun x -> G.Pa x)
      in
      let reqs = v3 |> List.concat_map (map_requirement env) in
      G.OtherExpr
        (("RequiresExpr", G.fake "RequiresExpr"), (G.Tk v1 :: params) @ reqs)
      |> G.e
  | RequiresClause v1 ->
      let expr = map_expr env v1 in
      G.OtherExpr (("RequiresClause", G.fake "RequiresClause"), [ G.E expr ])
      |> G.e
  | CoAwait (v1, v2) ->
      let expr = map_expr env v2 in
      G.OtherExpr (("co_await", v1), [ G.E expr ]) |> G.e
  | ParenExpr v1 ->
      let _l, v1, _r = map_paren env (map_expr env) v1 in
      v1
  | Ellipsis v1 ->
      let v1 = map_tok env v1 in
      G.Ellipsis v1 |> G.e
  | DeepEllipsis v1 ->
      let v1 = map_bracket env (map_expr env) v1 in
      G.DeepEllipsis v1 |> G.e
  | TypedMetavar (v1, v2) ->
      let v1 = map_ident env v1 and v2 = map_type_ env v2 in
      G.TypedMetavar (v1, G.fake ":", v2) |> G.e
  | DotAccessEllipsis (e, tk) -> G.DotAccessEllipsis (map_expr env e, tk) |> G.e
  | ExprTodo (v1, v2) ->
      let v1 = map_todo_category env v1
      and v2 = map_of_list (map_expr env) v2 in
      G.OtherExpr (v1, v2 |> List_.map (fun e -> G.E e)) |> G.e

and map_special_wrap _env (spec, tk) =
  (match spec with
  | This -> N (IdSpecial ((G.This, tk), G.empty_id_info ()))
  | Defined -> Special (G.Defined, tk)
  | SizeOf -> Special (G.Sizeof, tk)
  | AlignOf -> N (Id (("alignof", tk), G.empty_id_info ()))
  | OffsetOf -> N (Id (("offsetof", tk), G.empty_id_info ())))
  |> G.e

and map_argument env x : G.argument =
  match x with
  | Arg v1 ->
      let v1 = map_expr env v1 in
      G.Arg v1
  | ArgType v1 ->
      let v1 = map_type_ env v1 in
      G.ArgType v1
  | ArgAction v1 ->
      let v1 = map_action_macro env v1 in
      G.OtherArg (("ArgMacro", G.fake ""), v1)
  | ArgInits v1 ->
      let l, xs, r = map_brace env (map_of_list (map_initialiser env)) v1 in
      G.Arg (G.Container (G.Dict, (l, xs, r)) |> G.e)
  | ArgBlock x -> Arg (StmtExpr (Block (map_compound env x) |> G.s) |> G.e)

and map_action_macro env x : G.any list =
  match x with
  | ActMisc v1 ->
      let v1 = map_of_list (map_tok env) v1 in
      v1 |> List_.map (fun t -> G.Tk t)

and map_constant env x : G.expr =
  match x with
  | Int v1 -> G.L (G.Int v1) |> G.e
  | Float v1 ->
      let v1 = map_wrap env (map_of_option map_of_float) v1 in
      G.L (G.Float v1) |> G.e
  | Char v1 ->
      let v1 = map_wrap env map_of_string v1 in
      G.L (G.Char v1) |> G.e
  | String v1 ->
      let v1 = map_wrap env map_of_string v1 in
      G.L (G.String (fb v1)) |> G.e
  | MultiString v1 ->
      let v1 = map_of_list map_string_component v1 in
      G.interpolated (fb v1)
  | Bool v1 ->
      let v1 = map_wrap env map_of_bool v1 in
      G.L (G.Bool v1) |> G.e
  | Nullptr v1 ->
      let v1 = map_tok env v1 in
      G.L (G.Null v1) |> G.e

and map_string_component = function
  | StrIdent id -> Either_.Middle3 (G.N (Id (id, G.empty_id_info ())) |> G.e)
  | StrLit s -> Either_.Left3 s

and map_unaryOp _env = function
  | UnPlus -> Left G.Plus
  | UnMinus -> Left G.Minus
  | Tilde -> Left G.BitNot
  | Not -> Left G.Not
  | GetRef -> Right (fun tok e -> G.Ref (tok, e) |> G.e)
  | DeRef -> Right (fun tok e -> G.DeRef (tok, e) |> G.e)
  | GetRefLabel ->
      Right (fun tok e -> G.OtherExpr (("GetRefLabel", tok), [ G.E e ]) |> G.e)

and map_assignOp env = function
  | SimpleAssign v1 ->
      let v1 = map_tok env v1 in
      Left v1
  | OpAssign v1 ->
      let v1 = map_wrap env (map_arithOp env) v1 in
      Right v1

and map_fixOp _env = function
  | Dec -> G.Decr
  | Inc -> G.Incr

and map_dotOp _env = function
  | Dot -> Dot
  | Arrow -> Arrow

and map_binaryOp env x : G.operator =
  match x with
  | Arith v1 ->
      let v1 = map_arithOp env v1 in
      v1
  | Logical v1 ->
      let v1 = map_logicalOp env v1 in
      v1

and map_arithOp _env = function
  | Plus -> G.Plus
  | Minus -> G.Minus
  | Mul -> G.Mult
  | Div -> G.Div
  | Mod -> G.Mod
  | DecLeft -> G.LSL
  | DecRight -> G.LSR
  | And -> G.BitAnd
  | Or -> G.BitOr
  | Xor -> G.BitXor

and map_logicalOp _env = function
  | Inf -> G.Lt
  | Sup -> G.Gt
  | InfEq -> G.LtE
  | SupEq -> G.GtE
  | Eq -> G.Eq
  | NotEq -> G.NotEq
  | AndLog -> G.And
  | OrLog -> G.Or
  | Spaceship -> G.Cmp

and map_ptrOp _env = function
  | PtrStarOp -> PtrStarOp
  | PtrOp -> PtrOp

and map_allocOp _env = function
  | NewOp -> NewOp
  | DeleteOp -> DeleteOp
  | NewArrayOp -> NewArrayOp
  | DeleteArrayOp -> DeleteArrayOp

and map_accessop _env = function
  | ParenOp -> ParenOp
  | ArrayOp -> ArrayOp

and map_operator (env : env) = function
  | BinaryOp v1 ->
      let _v1 = map_binaryOp env v1 in
      ()
  | AssignOp v1 ->
      let _v1 = map_assignOp env v1 in
      ()
  | FixOp v1 ->
      let _v1 = map_fixOp env v1 in
      ()
  | PtrOpOp v1 ->
      let _v1 = map_ptrOp env v1 in
      ()
  | AccessOp v1 ->
      let _v1 = map_accessop env v1 in
      ()
  | AllocOp v1 ->
      let _v1 = map_allocOp env v1 in
      ()
  | UnaryTildeOp -> ()
  | DotStarOp -> ()
  | CoAwaitOp -> ()
  | UnaryNotOp -> ()
  | CommaOp -> ()
  | DQuoteOp -> ()

and map_requirement (env : env) = function
  | ExprReq (expropt, _sc) -> (
      match expropt with
      | None -> []
      | Some e -> [ G.E (map_expr env e) ])
  | TypeNameReq (_tk, name) -> [ G.Name (map_name env name) ]
  | CompoundReq ((_l1, e, _r1), tkopt, tyopt, _sc) ->
      let v1 = [ G.E (map_expr env e) ] in
      let v2 =
        match tkopt with
        | None -> []
        | Some tk -> [ G.Tk tk ]
      in
      let v3 =
        match tyopt with
        | None -> []
        | Some ty -> [ G.T (map_type_ env ty) ]
      in
      v1 @ v2 @ v3

and map_cast_operator _env = function
  | Static_cast -> "Static_cast"
  | Dynamic_cast -> "Dynamic_cast"
  | Const_cast -> "Const_cast"
  | Reinterpret_cast -> "Reinterpret_cast"

and map_a_const_expr env v = map_expr env v
and map_a_lhs env v = map_expr env v

and map_stmt env x : G.stmt =
  match x with
  | Compound v1 ->
      let v1 = map_compound env v1 in
      G.Block v1 |> G.s
  | ExprStmt v1 ->
      let eopt, sc = map_expr_stmt env v1 in
      let e = expr_option sc eopt in
      G.ExprStmt (e, sc) |> G.s
  | MacroStmt v1 ->
      let v1 = map_tok env v1 in
      G.OtherStmt (G.OS_Todo, [ G.TodoK ("MacroStmt", v1) ]) |> G.s
  | If (v1, v2, v3, v4, v5) ->
      let v1 = map_tok env v1
      and _v2TODO = map_of_option (map_tok env) v2 (* constexpr *)
      and _, cond, _ = map_paren env (map_condition_clause env) v3
      and v4 = map_stmt env v4
      and v5 =
        map_of_option
          (fun (v1, v2) ->
            let _else = map_tok env v1 and v2 = map_stmt env v2 in
            v2)
          v5
      in
      G.If (v1, cond, v4, v5) |> G.s
  | Switch (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_paren_skip env (map_condition_clause env) v2
      and v3 = map_cases env v1 v3 in
      G.Switch (v1, Some v2, v3) |> G.s
  | While (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _, cond, _ = map_paren env (map_condition_clause env) v2
      and v3 = map_stmt env v3 in
      G.While (v1, cond, v3) |> G.s
  | DoWhile (v1, v2, v3, v4, v5) ->
      let v1 = map_tok env v1
      and v2 = map_stmt env v2
      and _v3 = map_tok env v3
      and _, cond, _ = map_paren env (map_expr env) v4
      and _v5 = map_sc env v5 in
      G.DoWhile (v1, v2, cond) |> G.s
  | For (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _, header, _ = map_paren env (map_for_header env) v2
      and v3 = map_stmt env v3 in
      G.For (v1, header, v3) |> G.s
  | MacroIteration (v1, v2, v3) ->
      let v1 = map_ident env v1
      and v2 = map_paren_skip env (map_of_list (map_argument env)) v2
      and v3 = map_stmt env v3 in
      let anys = [ G.I v1; G.Args v2 ] in
      G.OtherStmtWithStmt (G.OSWS_Iterator, anys, v3) |> G.s
  | CoStmt ((op, op_tk), eopt) ->
      let op_str =
        match op with
        | Co_yield -> "co_yield"
        | Co_return -> "co_return"
      in
      let anys =
        match eopt with
        | None -> []
        | Some e -> [ G.E (map_expr env e) ]
      in
      G.OtherStmt (OS_Todo, G.I (op_str, op_tk) :: anys) |> G.s
  | AsmStmt
      ( asm_tk,
        (_l, { a_template; a_outputs; a_inputs; a_clobbers; a_gotos }, _r),
        sc ) ->
      let a_template = [ G.E (map_expr env a_template) ] in
      let a_outputs = List.concat_map (map_name_asm_operand env) a_outputs in
      let a_inputs = List.concat_map (map_expr_asm_operand env) a_inputs in
      let a_clobbers = List_.map (fun x -> G.I (map_ident env x)) a_clobbers in
      let a_gotos = List_.map (fun x -> G.I (map_ident env x)) a_gotos in
      G.OtherStmt
        ( G.OS_Asm,
          [ G.Tk asm_tk ] @ a_template @ a_outputs @ a_inputs @ a_clobbers
          @ a_gotos @ [ G.Tk sc ] )
      |> G.s
  | Jump (v1, v2) ->
      let v1 = map_jump env v1 and v2 = map_sc env v2 in
      v1 v2
  | Label (v1, v2, v3) ->
      let v1 = map_a_label env v1
      and _v2 = map_tok env v2
      and v3 = map_stmt env v3 in
      G.Label (v1, v3) |> G.s
  (* should be handled in map_cases *)
  | Case _
  | CaseRange _
  | Default _ ->
      let cases, xs = convert_case env x in
      let anys = cases |> List_.map (fun cs -> G.Cs cs) in
      let sts = map_of_list (map_stmt_or_decl env) xs |> List_.flatten in
      let st = G.stmt1 sts in
      G.OtherStmtWithStmt (OSWS_Todo, anys, st) |> G.s
  | Try (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_compound env v2
      and v3 = map_of_list (map_handler env) v3 in
      G.Try (v1, G.Block v2 |> G.s, v3, None, None) |> G.s
  | MsTry (v1, try_, v3) ->
      G.OtherStmtWithStmt (OSWS_SEH, [ G.Tk v1 ], map_ms_try_handler env try_ v3)
      |> G.s
  | MsLeave v1 -> G.OtherStmt (OS_Todo, [ G.Tk v1 ]) |> G.s
  | StmtTodo (v1, v2) ->
      let v1 = map_todo_category env v1
      and v2 = map_of_list (map_stmt env) v2 in
      let st = G.Block (Tok.unsafe_fake_bracket v2) |> G.s in
      G.OtherStmtWithStmt (OSWS_Todo, [ G.TodoK v1 ], st) |> G.s

and map_ms_try_handler env (l, inner, r) x =
  let inner =
    map_of_list (map_sequencable env (map_stmt_or_decl env)) inner
    |> List_.flatten
  in
  let try_stmt =
    G.OtherStmtWithStmt (OSWS_SEH, [], G.Block (l, inner, r) |> G.s) |> G.s
  in
  let inner_stmt =
    match x with
    | MsExcept (v1, (_, v2, _), (l', v3, r')) ->
        let contents =
          map_of_list (map_sequencable env (map_stmt_or_decl env)) v3
          |> List_.flatten
        in
        G.OtherStmtWithStmt
          ( OSWS_SEH,
            [ G.Tk v1; G.E (map_expr env v2) ],
            G.Block (l', contents, r') |> G.s )
        |> G.s
    | MsFinally (v1, (l', v2, r')) ->
        let contents =
          map_of_list (map_sequencable env (map_stmt_or_decl env)) v2
          |> List_.flatten
        in
        G.OtherStmtWithStmt
          (OSWS_SEH, [ G.Tk v1 ], G.Block (l', contents, r') |> G.s)
        |> G.s
  in
  G.Block (Tok.unsafe_fake_bracket [ try_stmt; inner_stmt ]) |> G.s

and map_expr_asm_operand env (v1, v2, v3) =
  let v1 =
    match v1 with
    | None -> []
    | Some (_, n, _) -> [ G.I n ]
  in
  let _, v3, _ = map_bracket env (map_expr env) v3 in
  v1 @ [ G.I v2 ] @ [ G.E v3 ]

and map_name_asm_operand _env (v1, v2, v3) =
  let v1 =
    match v1 with
    | None -> []
    | Some (_, n, _) -> [ G.I n ]
  in
  let _, v3, _ = v3 in
  v1 @ [ G.I v2 ] @ [ G.I v3 ]

(* similar to Ast_c_build.cases()
 * TODO: CaseEllipsis?
 *)
and map_cases env tk st : G.case_and_body list =
  match st with
  | Compound (_l, xs, _r) ->
      (* note that parser_cpp.mly and tree-sitter-cpp currently parse
       * differently 'case 1: i++; break'. In pfff the case accepts a
       * single stmt after, in tree-sitter a list of stmt (which is better)
       * so here for pfff we need to put back 'break' under the case.
       *)
      let rec aux xs =
        match xs with
        | [] -> []
        | x :: xs -> (
            match x with
            (* in tree-sitter-cpp, some Case have no body because they
             * are followed by another Case that will have them.
             * update: sometimes the body is also empty even without
             * a following case. Not sure why, see could_not_find_case.cpp.
             *)
            | X
                (S
                   (( Case (t, _, _, [])
                    | CaseRange (t, _, _, _, _, [])
                    | Default (t, _, []) ) as case1)) -> (
                let res = repack_case_with_following_cases env t case1 xs in
                match res with
                | Some (case_repack, rest) -> aux (X (S case_repack) :: rest)
                | None ->
                    (* weird, skip for now *)
                    let cases = [ G.OtherCase (("StmtNotCase", tk), []) ] in
                    let sts = map_sequencable env (map_stmt_or_decl env) x in
                    let st = G.stmt1 sts in
                    G.CasesAndBody (cases, st) :: aux xs)
            | X (S ((Case _ | CaseRange _ | Default _) as case1)) ->
                (* in pfff some statements may be without a leading case,
                 * so we need to repack them *)
                let before_next_case, rest =
                  xs
                  |> List_.span (function
                       | X (S (Case _ | CaseRange _ | Default _)) -> false
                       | _ -> true)
                in
                let case_repack =
                  repack_case_with_following_stmts env case1 before_next_case
                in
                let cases, xs = convert_case env case_repack in
                let sts =
                  map_of_list (map_stmt_or_decl env) xs |> List_.flatten
                in
                let st = G.stmt1 sts in
                G.CasesAndBody (cases, st) :: aux rest
            | _ ->
                (* non Case, weird, skip for now *)
                let cases = [ G.OtherCase (("StmtNotCase", tk), []) ] in
                let sts = map_sequencable env (map_stmt_or_decl env) x in
                let st = G.stmt1 sts in
                G.CasesAndBody (cases, st) :: aux xs)
      in
      aux xs
  | _ ->
      (* degenerated case *)
      let cases = [ G.OtherCase (("NoBlockInSwitch", tk), []) ] in
      let st = map_stmt env st in
      [ G.CasesAndBody (cases, st) ]

(* needed only for tree-sitter *)
and repack_case_with_following_cases env tk (st_case_empty_body : stmt) xs =
  let repack_empty_case new_case_body_stmt =
    match st_case_empty_body with
    | Case (v1, v2, v3, []) -> Case (v1, v2, v3, [ S new_case_body_stmt ])
    | CaseRange (v1, v2, v3, v4, v5, []) ->
        CaseRange (v1, v2, v3, v4, v5, [ S new_case_body_stmt ])
    | Default (v1, v2, []) -> Default (v1, v2, [ S new_case_body_stmt ])
    | _ -> raise Impossible
  in

  match xs with
  | [] ->
      (* tree-sitter may remove some tokens for error-recovery, leading
       * to some empty cases
       *)
      error_unless_partial_error env tk "empty case body, weird";
      Some (empty_stmt tk, [])
  | x :: xs -> (
      match x with
      | X
          (S
             (( Case (t, _, _, [])
              | CaseRange (t, _, _, _, _, [])
              | Default (t, _, []) ) as case1)) -> (
          (* recursive call, still got an empty case, need to go deeper *)
          let res = repack_case_with_following_cases env t case1 xs in
          match res with
          | None -> None
          | Some (case_repack, rest) ->
              Some (repack_empty_case case_repack, rest))
      | X
          (S
             (( Case (_, _, _, _)
              | CaseRange (_, _, _, _, _, _)
              | Default (_, _, _) ) as case1)) ->
          Some (repack_empty_case case1, xs)
      | _ ->
          (* could not find a case, maybe caller knows better *)
          None)

and repack_case_with_following_stmts _env (st_case_only : stmt) sts : stmt =
  let sts =
    sts
    |> List_.filter_map (function
         | X x -> Some x
         (* TODO? skipped directive code? *)
         | _ -> None)
  in
  match st_case_only with
  | Case (v1, v2, v3, v4) ->
      let v4 = v4 @ sts in
      Case (v1, v2, v3, v4)
  | CaseRange (v1, v2, v3, v4, v5, v6) ->
      let v6 = v6 @ sts in
      CaseRange (v1, v2, v3, v4, v5, v6)
  | Default (v1, v2, v3) ->
      let v3 = v3 @ sts in
      Default (v1, v2, v3)
  | _ -> raise Impossible

and map_case_body env tk case_body : G.case list * stmt_or_decl list =
  match case_body with
  | [] ->
      error_unless_partial_error env tk "empty case body, impossible";
      ([], [])
  | x :: xs -> (
      match x with
      (* merge all the cases together *)
      | S ((Case _ | CaseRange _ | Default _) as st1) ->
          let cases, rest = convert_case env st1 in
          (cases, rest @ xs)
      | _ ->
          let cases = [] in
          let rest = x :: xs in
          (cases, rest))

and convert_case env st_case_only : G.case list * stmt_or_decl list =
  match st_case_only with
  | Case (v1, v2, v3, v4) ->
      let v1 = map_tok env v1
      and v2 = map_expr env v2
      and _v3 = map_tok env v3
      and other_cases, sts = map_case_body env v1 v4 in
      let case1 = G.Case (v1, H.expr_to_pattern v2) in
      (case1 :: other_cases, sts)
  | CaseRange (v1, v2, v3, v4, v5, v6) ->
      let v1 = map_tok env v1
      and v2 = map_expr env v2
      and _v3 = map_tok env v3
      and v4 = map_expr env v4
      and _v5 = map_tok env v5
      and other_cases, sts = map_case_body env v1 v6 in
      let case1 = G.OtherCase (("CaseRange", v1), [ G.E v2; G.E v4 ]) in
      (case1 :: other_cases, sts)
  | Default (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _v2 = map_tok env v2
      and other_cases, sts = map_case_body env v1 v3 in
      let case1 = G.Default v1 in
      (case1 :: other_cases, sts)
  | _ -> raise Impossible

and map_expr_stmt env (v1, v2) =
  let v1 = map_of_option (map_expr env) v1 and v2 = map_sc env v2 in
  (v1, v2)

and map_condition_initializer (env : env) (x : condition_initializer) :
    G.any list =
  match x with
  | InitVarsDecl x ->
      let xs, _sc = map_vars_decl env x in
      xs |> List_.map (fun def -> G.Def def)
  | InitExprStmt x ->
      let eopt, sc = map_expr_stmt env x in
      [ G.S (G.ExprStmt (expr_option sc eopt, sc) |> G.s) ]
  | InitUsing x -> [ G.S (map_using env x) ]

and map_condition_subject env x =
  match x with
  | CondClassic v1 ->
      let v1 = map_expr env v1 in
      v1
  | CondOneDecl v1 ->
      let ent, vdef = map_var_decl env v1 in
      H.vardef_to_assign (ent, vdef)

and map_condition_clause env (v1, v2) : G.condition =
  let subject = map_condition_subject env v2 in
  match v1 with
  | None -> Cond subject
  | Some init ->
      let inits = map_condition_initializer env init in
      OtherCond (("OtherCond", G.fake "OtherCond"), inits @ [ G.E subject ])

and map_for_header env = function
  | ForEllipsis v1 -> G.ForEllipsis v1
  | ForClassic (v1, v2, v3) ->
      let v1 = map_a_expr_or_vars env v1
      and v2 = map_of_option (map_expr env) v2
      and v3 = map_of_option (map_expr env) v3 in
      G.ForClassic (v1, v2, v3)
  | ForRange (v1, (ty, ent), v3, v4) ->
      (* TODO: We cannot accommodate this in the Generic AST at the present. *)
      let _initialiser_TODO =
        map_of_option (map_condition_initializer env) v1
      in
      let ent = map_entity env ent
      and ty = map_type_ env ty
      and v2 = map_tok env v3
      and v4 = map_initialiser env v4 in
      (* TODO: use the other stuff in the entity? *)
      let pat =
        match ent.name with
        | EN (Id (id, idinfo)) -> G.PatId (id, idinfo) |> G.p
        | _ -> G.OtherPat (("PatEnt", G.fake "PatEnt"), [ G.En ent ]) |> G.p
      in
      (* less: or ForEach? *)
      G.ForEach (G.PatTyped (pat, ty) |> G.p, v2, v4)

and map_a_expr_or_vars (env : env) (v : a_expr_or_vars) : G.for_var_or_expr list
    =
  match v with
  | Left (Some e, _sc) ->
      let e = map_expr env e in
      [ ForInitExpr e ]
  | Left (None, _) -> []
  | Right xs ->
      let xs, _sc = map_vars_decl env xs in
      xs
      |> List_.map (fun (ent, def) ->
             match def with
             | G.VarDef vdef -> G.ForInitVar (ent, vdef)
             | _ ->
                 let e =
                   G.OtherExpr
                     (("ForInitNotVar", G.fake ""), [ G.Def (ent, def) ])
                   |> G.e
                 in
                 G.ForInitExpr e)

and map_a_label env v = map_wrap env map_of_string v

and map_jump env = function
  | Goto (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_a_label env v2 in
      fun sc -> G.Goto (v1, v2, sc) |> G.s
  | Continue v1 ->
      let v1 = map_tok env v1 in
      fun sc -> G.Continue (v1, G.LNone, sc) |> G.s
  | Break v1 ->
      let v1 = map_tok env v1 in
      fun sc -> G.Break (v1, G.LNone, sc) |> G.s
  | Return (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_of_option (map_argument env) v2 in
      let v2 = Option.map H.argument_to_expr v2 in
      fun sc -> G.Return (v1, v2, sc) |> G.s
  | GotoComputed (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _v2 = map_tok env v2
      and v3 = map_expr env v3 in
      (* less: could change G.Goto to take a label instead of label_ident? *)
      fun _sc ->
        G.OtherStmt (G.OS_Todo, [ G.TodoK ("GotoComputed", v1); G.E v3 ]) |> G.s

and map_handler env (v1, v2, v3) : G.catch =
  let v1 = map_tok env v1
  and _, x, _ = map_paren env (map_exception_declaration v1 env) v2
  and v3 = map_compound env v3 in
  (v1, x, G.Block v3 |> G.s)

and map_exception_declaration tok env x : G.catch_exn =
  match x with
  | ExnDecl v1 -> (
      let v1 = map_parameter env v1 in
      match (H.parameter_to_catch_exn_opt v1, env.in_mode) with
      (* `PatEllipsis` is not allowed in SAST transformation so we use
         `PatWildcard` instead when parsing the target file *)
      | Some (CatchPattern (PatEllipsis t)), Target ->
          CatchPattern (PatWildcard t)
      | Some (CatchPattern (PatEllipsis t)), Pattern ->
          CatchPattern (PatEllipsis t)
      | Some x, _ -> x
      | None, _ ->
          error tok "could not convert a parameter into a catch exn handler")

and map_stmt_or_decl env x : G.stmt list =
  match x with
  | S v1 ->
      let v1 = map_stmt env v1 in
      [ v1 ]
  | D v1 ->
      let v1 = map_decl env v1 in
      v1

and map_compound env (l, v, r) : G.stmt list bracket =
  let xs = map_of_list (map_sequencable env (map_stmt_or_decl env)) v in
  (l, List_.flatten xs, r)

and map_declarations env (l, v, r) : G.stmt list bracket =
  let xs = map_of_list (map_sequencable env (map_stmt_or_decl env)) v in
  (l, List_.flatten xs, r)

and map_entity env { name = v_name; specs = v_specs } : G.entity =
  let v_specs = map_of_list (map_specifier env) v_specs in
  let v_name = map_name env v_name in
  { G.name = G.EN v_name; attrs = v_specs; tparams = None }

and map_decl env x : G.stmt list =
  match x with
  | DeclList v1 ->
      let xs, sc = map_vars_decl env v1 in
      let defs = env.defs_toadd in
      env.defs_toadd <- [];
      defs @ xs |> H.add_semicolon_to_last_def_and_convert_to_stmts sc
  | UsingDecl v1 ->
      let v1 = map_using env v1 in
      [ v1 ]
  | NamespaceAlias (v1, v2, v3, v4, v5) ->
      let v1 = map_tok env v1
      and v2 = map_ident env v2
      and _v3 = map_tok env v3
      and v4 = map_name env v4
      and _v5 = map_sc env v5 in
      let dots = H.dotted_ident_of_name v4 in
      let dir =
        G.ImportAs (v1, G.DottedName dots, Some (v2, G.empty_id_info ())) |> G.d
      in
      [ G.DirectiveStmt dir |> G.s ]
  | Asm (v1, v2, v3, v4) ->
      let v1 = map_tok env v1
      and _volatileTODO = map_of_option (map_tok env) v2
      and v3 = map_paren_skip env (map_asmbody env) v3
      and v4 = map_sc env v4 in
      let anys = v3 in
      [
        G.OtherStmt (OS_Asm, [ G.TodoK ("Asm", v1) ] @ anys @ [ G.Tk v4 ])
        |> G.s;
      ]
  | Func v1 ->
      let v1 = map_func_definition env v1 in
      [ G.DefStmt v1 |> G.s ]
  | TemplateDecl (v1, v2, v3, v4) ->
      let _v1 = map_tok env v1
      and v2 = map_template_parameters env v2
      (* TODO *)
      and _v3 = map_of_option (map_expr env) v3
      and v4 = map_decl env v4 in
      v4
      |> List_.map
           (map_def_in_stmt (fun (ent, def) ->
                ({ ent with tparams = Some v2 }, def)))
  | TemplateInstanciation (v1, v2, v3) ->
      let _v1TODO = map_tok env v1
      and ent, vardef = map_var_decl env v2
      and _v3 = map_sc env v3 in
      [ G.DefStmt (ent, G.VarDef vardef) |> G.s ]
  | ExternDecl (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _v2TODO = map_wrap env map_of_string v2
      and v3 = map_decl env v3 in
      v3
      |> List_.map
           (map_def_in_stmt (fun (ent, def) ->
                let extern = G.attr Extern v1 in
                ({ ent with attrs = extern :: ent.attrs }, def)))
  | ExternList (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _v2TODO = map_wrap env map_of_string v2
      and _l, v3, _r = map_declarations env v3 in
      v3
      |> List_.map
           (map_def_in_stmt (fun (ent, def) ->
                let extern = G.attr Extern v1 in
                ({ ent with attrs = extern :: ent.attrs }, def)))
  | Namespace (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_of_option (map_name env) v2
      and _l, v3, r = map_declarations env v3 in
      let dotted =
        match v2 with
        | None -> []
        | Some x -> H.dotted_ident_of_name x
      in
      let dir1 = G.Package (v1, dotted) |> G.d in
      let dir2 = G.PackageEnd r |> G.d in
      [ G.DirectiveStmt dir1 |> G.s ] @ v3 @ [ G.DirectiveStmt dir2 |> G.s ]
  | StaticAssert (v1, v2) ->
      let v1 = map_tok env v1
      and v2 = map_paren env (map_of_list (map_argument env)) v2 in
      [ G.Assert (v1, v2, G.sc) |> G.s ]
  | Friend (v1, v2) ->
      let _v1TODO = map_tok env v1 and v2 = map_decl env v2 in
      v2
  | EmptyDef v1 ->
      let v1 = map_sc env v1 in
      [ G.emptystmt v1 ]
  | NotParsedCorrectly v1 ->
      let v1 = map_of_list (map_tok env) v1 in
      [ G.OtherStmt (G.OS_Todo, v1 |> List_.map (fun tk -> G.Tk tk)) |> G.s ]
  | Concept (tconcept, id, _tequals, expr, _sc) ->
      let id = map_ident env id in
      let expr = map_expr env expr in
      [
        G.DefStmt
          (G.basic_entity id, OtherDef (("concept", tconcept), [ G.E expr ]))
        |> G.s;
      ]
  | DeclTodo v1 ->
      let v1 = map_todo_category env v1 in
      [ G.OtherStmt (G.OS_Todo, [ G.TodoK v1 ]) |> G.s ]

and map_vars_decl env (v1, v2) : G.definition list * G.sc =
  let defs = map_of_list (map_onedecl env) v1 |> List_.flatten in
  let sc = map_sc env v2 in
  (defs, sc)

and map_asmbody env (v1, v2) : G.any list =
  let _v1 = map_of_list (map_wrap env map_of_string) v1
  and v2 = map_of_list (map_colon env) v2 in
  v2 |> List_.flatten

and map_colon env = function
  | Colon (v1, v2) ->
      let _v1 = map_tok env v1 and v2 = map_of_list (map_colon_option env) v2 in
      v2 |> List_.flatten

and map_colon_option env = function
  | ColonExpr (v1, v2) ->
      let _v1 = map_of_list (map_tok env) v1
      and v2 = map_paren_skip env (map_expr env) v2 in
      [ G.E v2 ]
  | ColonMisc v1 ->
      let _v1 = map_of_list (map_tok env) v1 in
      []

and map_onedecl env x : G.definition list =
  match x with
  | EmptyDecl t ->
      (* should populate env defs *)
      let _tTODO = map_type_ env t in
      []
  | TypedefDecl (tk, ty, id) ->
      let _tk = map_tok env tk in
      let ty = map_type_ env ty in
      let id = map_ident env id in
      let ent = G.basic_entity id in
      [ (ent, G.TypeDef { G.tbody = G.AliasType ty }) ]
  | V v1 ->
      let ent, vardef = map_var_decl env v1 in
      [ (ent, G.VarDef vardef) ]
  | StructuredBinding (v1, v2, v3) ->
      let v1 = map_type_ env v1 in
      let l, xs, r = map_bracket env (map_of_list (map_ident env)) v2 in
      let v3 = map_init env v3 in
      let pat =
        G.PatTuple
          (l, xs |> List_.map (fun id -> G.PatId (id, G.empty_id_info ())), r)
      in
      (* TODO: the type is the type of all bindings or type of init? *)
      let pat = G.PatTyped (pat, v1) in
      let ent = { G.name = G.EPattern pat; attrs = []; tparams = None } in
      (* TODO? use v1 for vtype? *)
      let def = G.VarDef { G.vinit = Some v3; vtype = None; vtok = G.no_sc } in
      [ (ent, def) ]
  | BitField (v1, v2, v3, v4) ->
      let v1 = map_of_option (map_ident env) v1
      and v2 = map_tok env v2
      and v3 = map_type_ env v3
      and v4 = map_a_const_expr env v4 in
      let def = G.OtherDef (("BitField", v2), [ G.T v3; G.E v4 ]) in
      let ent =
        match v1 with
        | None ->
            {
              G.name = G.OtherEntity (("AnonBitField", v2), []);
              attrs = [];
              tparams = None;
            }
        | Some id -> G.basic_entity id
      in
      [ (ent, def) ]

and map_var_decl env (ent, { v_init = v_v_init; v_type = v_v_type }) =
  let convert_var_decl () =
    let ent = map_entity env ent in
    let v_v_type = map_type_ env v_v_type in
    let v_v_init = map_of_option (map_init env) v_v_init in
    (ent, { G.vtype = Some v_v_type; vinit = v_v_init; vtok = G.no_sc })
  in
  let fun_def_as_var_def_with_ctor () =
    match (v_v_init, v_v_type) with
    | None, ([], TFunction { ft_ret = t; ft_params = p1, params, p2; _ }) ->
        let param_to_arg_opt = function
          | P
              {
                p_name = None;
                p_type = [], TypeName name;
                p_specs = [];
                p_val = None;
              } ->
              Some (Arg (N name))
          | ParamEllipsis t -> Some (Arg (Ellipsis t))
          | _ -> None
        in
        let ent = map_entity env ent in
        let v_v_type = map_type_ env t in
        let args = params |> List_.filter_map param_to_arg_opt in
        if List.length params <> List.length args then None
        else
          let v_v_init = map_init env (ObjInit (Args (p1, args, p2))) in
          Some
            ( ent,
              { G.vtype = Some v_v_type; vinit = Some v_v_init; vtok = G.no_sc }
            )
    | _ -> None
  in
  let var_def_with_ctor_as_fun_def () =
    match (v_v_init, v_v_type) with
    | Some (ObjInit (Args (p1, args, p2))), t ->
        let arg_to_param_opt = function
          | Arg (N name) ->
              Some
                (P
                   {
                     p_name = None;
                     p_type = ([], TypeName name);
                     p_specs = [];
                     p_val = None;
                   })
          | Arg (Ellipsis t) -> Some (ParamEllipsis t)
          | _ -> None
        in
        let ent = map_entity env ent in
        let params = args |> List_.filter_map arg_to_param_opt in
        if List.length params <> List.length args then None
        else
          let v_v_type =
            map_type_ env
              ( [],
                TFunction
                  {
                    ft_ret = t;
                    ft_params = (p1, params, p2);
                    ft_specs = [];
                    ft_const = None;
                    ft_throw = [];
                    ft_requires = None;
                  } )
          in
          Some (ent, { G.vtype = Some v_v_type; vinit = None; vtok = G.no_sc })
    | _ -> None
  in
  let result =
    match (env.parsing_pref, env.in_scope) with
    (* In C++, there's a syntactic ambiguity when you come across the
       syntax `[type] [variable] ([args]);`. This structure could be
       interpreted either as initializing a variable or defining a
       function, depending on the enclosing context. To eliminate this
       uncertainty, we convert such syntax to object initialization when
       it's found in a function body. Otherwise, we leave it as the
       parser interprets it. In cases where the context is unclear (for
       example, parsing a pattern), and to ensure it's recognized as
       variable initialization, you can use double parentheses. This
       makes it unequivocally a variable initialization and prevents it
       from being misinterpreted as defining a function. *)
    | Some `AsFunDef, _ -> var_def_with_ctor_as_fun_def ()
    | Some `AsVarDefWithCtor, _ -> fun_def_as_var_def_with_ctor ()
    | None, InFunction -> fun_def_as_var_def_with_ctor ()
    | _ -> Some (convert_var_decl ())
  in
  Option.value result ~default:(convert_var_decl ())

and map_init env x : G.expr =
  match x with
  | EqInit (v1, v2) ->
      let _v1 = map_tok env v1 and v2 = map_initialiser env v2 in
      v2
  | ObjInit v1 ->
      let l, args, r = map_obj_init env v1 in
      (* TODO? if initializer has designator, should make it a Record? *)
      G.Container (G.Array, (l, args |> List_.map H.argument_to_expr, r)) |> G.e
  | Bitfield (v1, v2) ->
      let _v1TODO = map_tok env v1 and v2 = map_a_const_expr env v2 in
      v2

and map_obj_init env x : G.argument list bracket =
  match x with
  | Args v1 ->
      let v1 = map_paren env (map_of_list (map_argument env)) v1 in
      v1
  | Inits v1 ->
      let lbrace, xs, rbraces =
        map_brace env (map_of_list (map_initialiser env)) v1
      in
      (lbrace, xs |> List_.map G.arg, rbraces)

and map_initialiser env x : G.expr = map_initialiser_bis env x

and map_initialiser_bis env x =
  match x with
  | InitExpr v1 ->
      let v1 = map_expr env v1 in
      v1
  | InitList v1 ->
      (* TODO: should look in xs for either and decide to build an Array
       * or a Dict
       *)
      let l, xs, r = map_brace env (map_of_list (map_initialiser_bis env)) v1 in
      G.Container (G.Array, (l, xs, r)) |> G.e
  | InitDesignators (v1, v2, v3) ->
      let _v1TODO = map_of_list (map_designator env) v1
      and _v2 = map_tok env v2
      and v3 = map_initialiser env v3 in
      v3
  | InitFieldOld (v1, v2, v3) ->
      let _v1TODO = map_ident env v1
      and _v2 = map_tok env v2
      and v3 = map_initialiser env v3 in
      v3
  | InitIndexOld (v1, v2) ->
      let _v1TODO = map_bracket env (map_expr env) v1
      and v2 = map_initialiser env v2 in
      v2

and map_designator env = function
  | DesignatorField (v1, v2) ->
      let _v1 = map_tok env v1 and v2 = map_ident env v2 in
      Left3 v2
  | DesignatorIndex v1 ->
      let _, v1, _ = map_bracket env (map_expr env) v1 in
      Middle3 v1
  | DesignatorRange v1 ->
      let _, v1, _ =
        map_bracket env
          (fun (v1, v2, v3) ->
            let v1 = map_expr env v1
            and _v2 = map_tok env v2
            and v3 = map_expr env v3 in
            (v1, v3))
          v1
      in
      Right3 v1

and map_func_definition env (v1, v2) : G.definition =
  let env = { env with in_scope = InFunction } in
  let v1 = map_entity env v1 and v2 = map_function_definition env v2 in
  (v1, FuncDef v2)

and map_function_definition env
    { f_type = v_f_type; f_body = v_f_body; f_specs = v_f_specs } :
    G.function_definition =
  let _v_f_specsTODO = map_of_list (map_specifier env) v_f_specs in
  let fbody, _attrsTODO = map_function_body env v_f_body in
  let fparams, fret = map_functionType env v_f_type in
  { G.fkind = (G.Function, G.fake ""); fparams; frettype = Some fret; fbody }

and map_functionType env x : G.parameters * G.type_ =
  match x with
  | {
   ft_ret = v_ft_ret;
   ft_params = v_ft_params;
   ft_specs = v_ft_specs;
   ft_const = v_ft_const;
   ft_throw = v_ft_throw;
   ft_requires = v_ft_requires;
  } ->
      let _v_ft_throwTODO = map_of_list (map_exn_spec env) v_ft_throw in
      let _v_ft_constTODO = map_of_option (map_tok env) v_ft_const in
      let _v_ft_specsTODO = map_of_list (map_specifier env) v_ft_specs in
      let _v_ft_requiresTODO = map_of_option (map_expr env) v_ft_requires in
      let params =
        map_paren env (map_of_list (map_parameter env)) v_ft_params
      in
      let tret = map_type_ env v_ft_ret in
      (params, tret)

and map_parameter env x : G.parameter =
  match x with
  | P v1 ->
      let v1 = map_parameter_classic env v1 in
      G.Param v1
  | ParamVariadic (v1, v2, v3) ->
      let _v1TODO = map_of_option (map_tok env) v1
      and v2 = map_tok env v2
      and v3 = map_parameter_classic env v3 in
      G.ParamRest (v2, v3)
  | ParamEllipsis v1 ->
      let v1 = map_tok env v1 in
      G.ParamEllipsis v1
  | ParamTodo (v1, v2) ->
      let v1 = map_todo_category env v1
      and v2 = map_of_list (map_parameter env) v2 in
      G.OtherParam (v1, v2 |> List_.map (fun x -> G.Pa x))

and map_parameter_classic env
    {
      p_name = v_p_name;
      p_type = v_p_type;
      p_specs = v_p_specs;
      p_val = v_p_val;
    } : G.parameter_classic =
  let v_p_val =
    map_of_option
      (fun (v1, v2) ->
        let _v1 = map_tok env v1 and v2 = map_expr env v2 in
        v2)
      v_p_val
  in
  let v_p_specs = map_of_list (map_specifier env) v_p_specs in
  let v_p_type = map_type_ env v_p_type in
  let v_p_name = map_of_option (map_ident env) v_p_name in
  {
    G.pname = v_p_name;
    ptype = Some v_p_type;
    pattrs = v_p_specs;
    pdefault = v_p_val;
    pinfo = G.empty_id_info ();
  }

and map_exn_spec env = function
  | ThrowSpec (v1, v2) ->
      let _v1 = map_tok env v1
      and _, v2, _ = map_paren env (map_of_list (map_type_ env)) v2 in
      Left v2
  | Noexcept (v1, v2) ->
      let _v1 = map_tok env v1
      and v2 =
        map_of_option
          (map_paren_skip env (map_of_option (map_a_const_expr env)))
          v2
      in
      Right v2

and map_function_body env x : G.function_body * G.attribute list =
  match x with
  | FBDef v1 ->
      let v1 = map_function_definition_body env v1 in
      (G.FBStmt (G.Block v1 |> G.s), [])
  | FBDecl v1 ->
      let v1 = map_sc env v1 in
      (G.FBDecl v1, [])
  | FBZero (v1, v2, v3) ->
      let _v1 = map_tok env v1 and v2 = map_tok env v2 and v3 = map_sc env v3 in
      let attr = G.attr G.Abstract v2 in
      (G.FBDecl v3, [ attr ])
  | FBDefault (v1, v2, v3) ->
      let _v1 = map_tok env v1 and v2 = map_tok env v2 and v3 = map_sc env v3 in
      let attr = G.unhandled_keywordattr ("DefaultedFunction", v2) in
      (G.FBDecl v3, [ attr ])
  | FBDelete (v1, v2, v3) ->
      let _v1 = map_tok env v1 and v2 = map_tok env v2 and v3 = map_sc env v3 in
      let attr = G.unhandled_keywordattr ("DeletedFunction", v2) in
      (G.FBDecl v3, [ attr ])
  | FBTry (v1, v2, v3) ->
      let v1 = map_tok env v1
      and v2 = map_function_definition_body env v2
      and v3 = map_of_list (map_handler env) v3 in
      let attr = G.unhandled_keywordattr ("FunctionTryBlock", v1) in
      (G.FBStmt (G.Try (v1, G.Block v2 |> G.s, v3, None, None) |> G.s), [ attr ])

and map_function_definition_body env x =
  match x with
  | Normal x -> map_compound env x
  | Constr (inits, x) ->
      let l, body, r = map_compound env x in
      let l2 =
        List.concat_map
          (fun (n, inits) ->
            let _, args, _ = map_obj_init env inits in
            [ G.Name (map_name env n); G.Args args ])
          inits
      in
      (l, (G.OtherStmt (OS_Todo, l2) |> G.s) :: body, r)

and map_lambda_definition env (v1, v2) : G.function_definition =
  let _v1TODO = map_bracket env (map_of_list (map_lambda_capture env)) v1
  and v2 = map_function_definition env v2 in
  v2

and map_lambda_capture env = function
  | CaptureEq v1 ->
      let v1 = map_tok env v1 in
      Left v1
  | CaptureRef v1 ->
      let v1 = map_tok env v1 in
      Left v1
  | CaptureOther v1 ->
      let v1 = map_expr env v1 in
      Right v1

and map_enum_definition env
    {
      enum_kind = v_enum_kind;
      enum_name = v_enum_name;
      enum_body = v_enum_body;
    } : G.name option * G.type_definition =
  let _l, v_enum_body, _r =
    map_brace env
      (map_of_list (map_sequencable_for_or_type env (map_enum_elem env)))
      v_enum_body
  in
  let v_enum_name = map_of_option (map_name env) v_enum_name in
  let _v_enum_kindTODO = map_tok env v_enum_kind in
  (v_enum_name, { G.tbody = G.OrType (List_.flatten v_enum_body) })

and map_enum_elem env { e_name = v_e_name; e_val = v_e_val } : G.or_type_element
    =
  let v_e_val =
    map_of_option
      (fun (v1, v2) ->
        let _v1 = map_tok env v1 and v2 = map_a_const_expr env v2 in
        v2)
      v_e_val
  in
  let v_e_name = map_ident env v_e_name in
  G.OrEnum (v_e_name, v_e_val)

and map_class_definition env (v1, v2) : G.name option * G.class_definition =
  let env = { env with in_scope = InClass } in
  let v1 = map_of_option (map_a_class_name env) v1
  and v2 = map_class_definition_bis env v2 in
  (v1, v2)

and map_class_definition_bis env
    { c_kind = v_c_kind; c_inherit = v_c_inherit; c_members = v_c_members } :
    G.class_definition =
  let l, v_c_members, r =
    map_brace env
      (map_of_list (map_sequencable_for_field env (map_class_member env)))
      v_c_members
  in
  let v_c_kind, _attrsTODO = map_class_key env v_c_kind in
  let v_c_inherit = map_of_list (map_base_clause env) v_c_inherit in
  let fields = List_.flatten v_c_members |> distribute_access in
  {
    G.ckind = v_c_kind;
    cextends = v_c_inherit;
    cimplements = [];
    cmixins = [];
    cparams = fb [];
    cbody = (l, fields, r);
  }

and map_class_key env (k, t) =
  let t = map_tok env t in
  match k with
  (* todo: Struct are really just class with public: appended
   * just after, so we should return a function to apply to all
   * members?
   *)
  | Struct -> ((G.Class, t), [ G.attr G.RecordClass t ])
  | Union -> ((G.Class, t), [ G.unhandled_keywordattr ("Union", t) ])
  | Class -> ((G.Class, t), [])

and map_base_clause env
    { i_name = v_i_name; i_virtual = v_i_virtual; i_access = v_i_access } :
    G.class_parent =
  let _v_i_accessTODO =
    map_of_option (map_wrap env (map_access_spec env)) v_i_access
  in
  let _v_i_virtualTODO = map_of_option (map_modifier env) v_i_virtual in
  let v_i_name = map_a_class_name env v_i_name in
  (G.TyN v_i_name |> G.t, None)

and map_class_member env x : (G.field, G.attribute) Either.t list =
  match x with
  | Access (v1, v2) ->
      let v1 = map_wrap env (map_access_spec env) v1 and _v2 = map_tok env v2 in
      (* we will apply access_spec to all that follows (until next Access)
       * in distribute_access() in the caller.
       *)
      [ Right (G.KeywordAttr v1) ]
  | QualifiedIdInClass (v1, v2) ->
      let v1 = map_name env v1 and v2 = map_sc env v2 in
      let e = G.N v1 |> G.e in
      let st = G.ExprStmt (e, v2) |> G.s in
      [ Left (G.F st) ]
  | F v1 ->
      let v1 = map_decl env v1 in
      v1 |> List_.map (fun st -> Left (G.F st))

and map_template_parameter env x : G.type_parameter =
  match x with
  | TP v1 ->
      let v1 = map_parameter env v1 in
      parameter_to_type_parameter v1
  | TPClass (v1, v2, v3) -> (
      let v1 = map_tok env v1
      and v2 = map_of_option (map_ident env) v2
      and v3 = map_of_option (map_type_ env) v3 in
      match (v2, v3) with
      | Some id, v3 -> G.tparam_of_id id ?tp_default:v3
      | None, None -> G.OtherTypeParam (("AnonTypeParam", v1), [])
      | None, Some t ->
          G.OtherTypeParam (("AnonTypeParamWithType", v1), [ G.T t ]))
  | TPVariadic (v1, v2, v3) -> (
      let _v1 = map_tok env v1
      and v2 = map_tok env v2
      and v3 = map_of_option (map_ident env) v3 in
      match v3 with
      | None -> G.OtherTypeParam (("TPVariadic", v2), [])
      | Some id -> G.OtherTypeParam (("TPVariadic", v2), [ G.I id ]))
  | TPNested (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _, v2, _ = map_template_parameters env v2
      and v3 = map_template_parameter env v3 in
      G.OtherTypeParam
        (("TPNested", v1), v3 :: v2 |> List_.map (fun x -> G.Tp x))

and map_template_parameters env v : G.type_parameters =
  map_angle env (map_of_list (map_template_parameter env)) v

and map_specifier env x : G.attribute =
  match x with
  | A v1 ->
      let v1 = map_attribute env v1 in
      v1
  | M v1 ->
      let v1 = map_modifier env v1 in
      v1
  | TQ v1 ->
      let v1 = map_qualifier_wrap env v1 in
      v1
  | ST v1 ->
      let v1 = map_storage env v1 in
      v1

and map_attribute env x : G.attribute =
  match x with
  | UnderscoresAttr (v1, v2) ->
      let v1 = map_tok env v1
      and l1, (_l2, xs, _r2), r1 =
        map_paren env (map_paren env (map_of_list (map_argument env))) v2
      in
      let name = H.name_of_id ("__attribute", v1) in
      G.NamedAttr (v1, name, (l1, xs, r1))
  | BracketsAttr v1 ->
      let l, xs, _r = map_bracket env (map_of_list (map_expr env)) v1 in
      G.OtherAttribute (("BracketsAttr", l), xs |> List_.map (fun e -> G.E e))
  | DeclSpec (v1, v2) ->
      let v1 = map_tok env v1 and l, id, r = map_paren env (map_ident env) v2 in
      let name = H.name_of_id ("__declspec", v1) in
      let arg = G.Arg (G.N (H.name_of_id id) |> G.e) in
      G.NamedAttr (v1, name, (l, [ arg ], r))

and map_modifier env = function
  | Inline v1 ->
      let v1 = map_tok env v1 in
      G.attr G.Inline v1
  | Virtual v1 ->
      let v1 = map_tok env v1 in
      G.attr G.Abstract v1
  | Final v1 ->
      let v1 = map_tok env v1 in
      G.attr G.Final v1
  | Override v1 ->
      let v1 = map_tok env v1 in
      G.attr G.Override v1
  | MsCall v1 ->
      let v1 = map_wrap env map_of_string v1 in
      G.unhandled_keywordattr v1
  | Explicit (v1, v2) ->
      let v1 = map_tok env v1
      and _v2 = map_of_option (map_paren env (map_expr env)) v2 in
      G.unhandled_keywordattr ("explicit", v1)
  | AlignAs (tk, (l, arg, r)) ->
      let arg = map_argument env arg in
      OtherAttribute (("AlignAs", tk), [ G.Tk l; G.Ar arg; G.Tk r ])

and map_access_spec _env = function
  | Public -> G.Public
  | Private -> G.Private
  | Protected -> G.Protected

and map_storage _env (x, t) : G.attribute =
  match x with
  | Auto -> G.unhandled_keywordattr ("auto", t)
  | Static -> G.attr G.Static t
  | Register -> G.unhandled_keywordattr ("register", t)
  | Extern -> G.attr G.Extern t
  | StoInline -> G.attr G.Inline t
  | ThreadLocal -> G.unhandled_keywordattr ("thread_local", t)

and map_pointer_modifier env x : G.attribute =
  match x with
  | Based (v1, v2) ->
      let v1 = map_tok env v1
      and v2 = map_paren env (map_of_list (map_argument env)) v2 in
      let name = H.name_of_id ("__based", v1) in
      G.NamedAttr (v1, name, v2)
  | PtrRestrict v1 ->
      let v1 = map_tok env v1 in
      G.unhandled_keywordattr ("PtrRestrict", v1)
  | Uptr v1 ->
      let v1 = map_tok env v1 in
      G.unhandled_keywordattr ("Uptr", v1)
  | Sptr v1 ->
      let v1 = map_tok env v1 in
      G.unhandled_keywordattr ("Sptr", v1)
  | Unaligned v1 ->
      let v1 = map_tok env v1 in
      G.unhandled_keywordattr ("Unaligned", v1)

and map_using env (v1, v2, v3) : G.stmt =
  let v1 = map_tok env v1
  and v2 = map_using_kind env v2
  and _v3 = map_sc env v3 in
  v2 v1 |> def_or_dir_either_to_stmt

and map_using_kind env x : G.tok -> (G.directive, G.definition) Either.t =
  match x with
  | UsingName v1 -> (
      let v1 = map_name env v1 in
      fun tk ->
        let xs = H.dotted_ident_of_name v1 in
        match List.rev xs with
        | [] -> error tk "Empty name in UsingName"
        | x :: xs ->
            let dots = List.rev xs in
            Left
              (G.ImportFrom
                 (tk, G.DottedName dots, [ H.mk_import_from_kind x None ])
              |> G.d))
  | UsingNamespace (v1, v2) ->
      let v1 = map_tok env v1 and v2 = map_a_ident_name env v2 in
      fun tk ->
        let dots = H.dotted_ident_of_name v2 in
        Left (G.ImportAll (tk, G.DottedName dots, Tok.fake_tok v1 "") |> G.d)
  | UsingAlias (v1, v2, v3) ->
      fun _tk ->
        let v1 = map_ident env v1
        and _v2 = map_tok env v2
        and v3 = map_type_ env v3 in
        let ent = G.basic_entity v1 in
        let def = G.TypeDef { G.tbody = G.AliasType v3 } in
        Right (ent, def)
  (* I'm assuming this just brings a name in like UsingName. *)
  | UsingEnum (_tk, v1) -> (
      let v1 = map_name env v1 in
      fun tk ->
        let xs = H.dotted_ident_of_name v1 in
        match List.rev xs with
        | [] -> error tk "Empty name in UsingName"
        | x :: xs ->
            let dots = List.rev xs in
            Left
              (G.ImportFrom
                 (tk, G.DottedName dots, [ H.mk_import_from_kind x None ])
              |> G.d))

and map_cpp_directive env x : (G.directive, G.definition) Either.t =
  match x with
  | Define (v1, v2, v3, v4) ->
      let _v1 = map_tok env v1
      and v2 = map_ident env v2
      and v3 = map_define_kind env v3
      and v4 = map_define_val env v4 in
      let ent = G.basic_entity v2 in
      let def = (ent, G.MacroDef { G.macroparams = v3; macrobody = v4 }) in
      Right def
  | Include (v1, v2) -> (
      let v1 = map_tok env v1 and v2 = map_include_kind env v2 in
      match v2 with
      | Left file ->
          let dir = G.ImportAll (v1, G.FileName file, v1) |> G.d in
          Left dir
      | Right e ->
          let dir =
            G.OtherDirective (("IncludeDynamic", v1), [ G.E e ]) |> G.d
          in
          Left dir)
  | Undef v1 ->
      let v1 = map_ident env v1 in
      let dir = G.OtherDirective (("Undef", snd v1), [ G.I v1 ]) |> G.d in
      Left dir
  | PragmaAndCo v1 ->
      let v1 = map_tok env v1 in
      let dir = G.Pragma (("PragmaAndCo", v1), []) |> G.d in
      Left dir

and map_define_kind env x : G.ident list =
  match x with
  | DefineVar -> []
  | DefineMacro v1 ->
      let _l, xs, _r = map_paren env (map_of_list (map_ident env)) v1 in
      xs

and map_define_val env = function
  | DefineExpr v1 ->
      let v1 = map_expr env v1 in
      [ G.E v1 ]
  | DefineStmt v1 ->
      let v1 = map_stmt env v1 in
      [ G.S v1 ]
  | DefineType v1 ->
      let v1 = map_type_ env v1 in
      [ G.T v1 ]
  | DefineFunction v1 ->
      let v1 = map_func_definition env v1 in
      [ G.Def v1 ]
  | DefineInit v1 ->
      let v1 = map_initialiser env v1 in
      [ G.E v1 ]
  | DefineDoWhileZero (v1, v2, v3, v4) ->
      let _v1 = map_tok env v1
      and v2 = map_stmt env v2
      and _v3 = map_tok env v3
      and _v4 = map_paren env (map_tok env) v4 in
      [ G.S v2 ]
  | DefinePrintWrapper (v1, v2, v3) ->
      let v1 = map_tok env v1
      and _l, v2, _r = map_paren env (map_expr env) v2
      and v3 = map_name env v3 in
      [ G.Tk v1; G.E v2; G.E (G.N v3 |> G.e) ]
  | DefineEmpty -> []
  | DefineTodo v1 ->
      let v1 = map_todo_category env v1 in
      [ G.TodoK v1 ]

and map_include_kind env = function
  | IncLocal v1 ->
      let v1 = map_wrap env map_of_string v1 in
      Left v1
  | IncSystem v1 ->
      let v1 = map_wrap env map_of_string v1 in
      Left v1
  | IncOther v1 ->
      let v1 = map_a_cppExpr env v1 in
      Right v1

and map_a_cppExpr env v = map_expr env v

(* TODO: ifdef_skipper like in ast_c_build.ml *)
and map_sequencable :
    'a. env -> ('a -> G.stmt list) -> 'a sequencable -> G.stmt list =
 fun env _of_a -> function
  | X v1 ->
      let v1 = _of_a v1 in
      v1
  | CppDirective v1 ->
      let v1 = map_cpp_directive env v1 in
      [ def_or_dir_either_to_stmt v1 ]
  | CppIfdef v1 ->
      let _v1TODO = map_ifdef_directive env v1 in
      []
  | MacroDecl (v1, v2, v3, v4) ->
      let v1 = map_of_list (map_specifier env) v1
      and v2 = map_ident env v2
      and _, xs, _ = map_paren env (map_of_list (map_argument env)) v3
      and v4 = map_tok env v4 in
      let ent = G.basic_entity ~attrs:v1 v2 in
      let def = G.OtherDef (("MacroDecl", snd v2), [ G.Args xs; G.Tk v4 ]) in
      [ G.DefStmt (ent, def) |> G.s ]
  | MacroVar (v1, v2) ->
      let v1 = map_ident env v1 and v2 = map_sc env v2 in
      let ent = G.basic_entity v1 in
      let def = G.OtherDef (("MacroVar", snd v1), [ G.Tk v2 ]) in
      [ G.DefStmt (ent, def) |> G.s ]

(* mostly copy-paste of function above but with different type
 * with the field local helper
 *)
and map_sequencable_for_field :
    'a.
    env ->
    ('a -> (G.field, G.attribute) Either.t list) ->
    'a sequencable ->
    (G.field, G.attribute) Either.t list =
  let field x = Left (G.F x) in
  fun env _of_a -> function
    | X v1 ->
        let v1 = _of_a v1 in
        v1
    | CppDirective v1 ->
        let v1 = map_cpp_directive env v1 in
        [ def_or_dir_either_to_stmt v1 |> field ]
    | CppIfdef v1 ->
        let _v1 = map_ifdef_directive env v1 in
        []
    | MacroDecl (v1, v2, v3, v4) ->
        let v1 = map_of_list (map_specifier env) v1
        and v2 = map_ident env v2
        and _, xs, _ = map_paren env (map_of_list (map_argument env)) v3
        and v4 = map_tok env v4 in
        let ent = G.basic_entity ~attrs:v1 v2 in
        let def = G.OtherDef (("MacroDecl", snd v2), [ G.Args xs; G.Tk v4 ]) in
        [ G.DefStmt (ent, def) |> G.s |> field ]
    | MacroVar (v1, v2) ->
        let v1 = map_ident env v1 and v2 = map_sc env v2 in
        let ent = G.basic_entity v1 in
        let def = G.OtherDef (("MacroVar", snd v1), [ G.Tk v2 ]) in
        [ G.DefStmt (ent, def) |> G.s |> field ]

and map_sequencable_for_or_type :
    'a.
    env -> ('a -> G.or_type_element) -> 'a sequencable -> G.or_type_element list
    =
 fun _env _of_a -> function
  | X v1 ->
      let v1 = _of_a v1 in
      [ v1 ]
  | CppDirective _
  | CppIfdef _
  | MacroDecl _
  | MacroVar _ ->
      []

and map_ifdef_directive env = function
  | Ifdef v1 ->
      let _v1 = map_tok env v1 in
      ()
  | IfdefElse v1 ->
      let _v1 = map_tok env v1 in
      ()
  | IfdefElseif v1 ->
      let _v1 = map_tok env v1 in
      ()
  | IfdefEndif v1 ->
      let _v1 = map_tok env v1 in
      ()

let map_toplevel env v = map_sequencable env (map_stmt_or_decl env) v

let map_program env v : G.program =
  map_of_list (map_toplevel env) v |> List_.flatten

let map_any env x : G.any =
  match x with
  | Expr v1 ->
      let v1 = map_expr env v1 in
      G.E v1
  | Stmt v1 ->
      let v1 = map_stmt env v1 in
      G.S v1
  | Stmts v1 ->
      let v1 = map_of_list (map_stmt env) v1 in
      G.Ss v1
  | Toplevel v1 ->
      let v1 = map_toplevel env v1 in
      G.Ss v1
  | Toplevels v1 ->
      let v1 = map_of_list (map_toplevel env) v1 |> List_.flatten in
      G.Ss v1
  | Program v1 ->
      let v1 = map_program env v1 in
      G.Ss v1
  | Cpp v1 ->
      let v1 = map_cpp_directive env v1 in
      G.S (def_or_dir_either_to_stmt v1)
  | Type v1 ->
      let v1 = map_type_ env v1 in
      G.T v1
  | Name v1 ->
      let v1 = map_name env v1 in
      G.Name v1
  | OneDecl v1 ->
      let v1 = map_onedecl env v1 in
      G.Ss (v1 |> List_.map (fun def -> G.DefStmt def |> G.s))
  | Init v1 ->
      let v1 = map_initialiser env v1 in
      G.E v1
  | ClassMember v1 ->
      let v1 = map_class_member env v1 in
      G.Flds (distribute_access v1)
  | Constant v1 ->
      let v1 = map_constant env v1 in
      G.E v1
  | Argument v1 ->
      let v1 = map_argument env v1 in
      G.Ar v1
  | Parameter v1 ->
      let v1 = map_parameter env v1 in
      G.Pa v1
  | Body v1 ->
      let v1 = map_compound env v1 in
      let st = G.Block v1 |> G.s in
      G.S st
  | Info v1 ->
      let v1 = map_tok env v1 in
      G.Tk v1
  | InfoList v1 ->
      let v1 = map_of_list (map_tok env) v1 in
      G.Anys (v1 |> List_.map (fun tk -> G.Tk tk))

(*****************************************************************************)
(* Entry point *)
(*****************************************************************************)
let any ?parsing_opt x =
  let env = empty_env () in
  let env = { env with parsing_pref = parsing_opt; in_mode = Pattern } in
  map_any env x

let program cst =
  let env = empty_env () in
  (* less: could assert env.defs_to_add is empty *)
  map_program env cst
